Setup
Data
### read all environmental raster data ----
files<-dir(here::here("data-raw",
"geo-raw",
"all_environmental_rasters_10m_3035"),pattern = "*.tif")
raster_stack <- files %>%
map(~raster(file.path(here::here("data-raw",
"geo-raw",
"all_environmental_rasters_10m_3035"), .)))%>%
stack()
names(raster_stack) [1] "distance_to_border_3035"
[2] "distance_to_open_green_areas_raster_2020_10m_3035"
[3] "distance_to_streets_berlin_raster_10m_2015_3035"
[4] "green_capacity_berlin_raster_10m_2010_3035"
[5] "human_population_density_raster_10m_2017_3035"
[6] "imperviousness_berlin_copernicus_raster_10m_2018_3035"
[7] "summer_temperature_berlin_04h_2016_3035"
[8] "summer_temperature_berlin_14h_2016_3035"
[9] "supply_green_areas_berlin_raster_10m_2016_3035"
[10] "traffic_volume_berlin_raster_10m_2014_3035" # create own function, focal analysis can't be applied on raster stack / brick simulatenously ----
multiFocal <- function(x, w=matrix(1, nr=11, nc=11), ...) {
if(is.character(x)) {
x <- brick(x)
}
# The function to be applied to each individual layer
fun <- function(ind, x, w, ...){
focal(x[[ind]], w=w, ...)
}
n <- seq(nlayers(x))
list <- lapply(X=n, FUN=fun, x=x, w=w, ...)
out <- stack(list)
return(out)
}
################################################################################
# Apply focal mean on all raster layers ----
focal_mean_stack<-raster_stack%>%
multiFocal()
names(focal_mean_stack)<-names(raster_stack)
plot(focal_mean_stack,colna="red")
ct_locations<-readRDS(here("output",
"data-proc",
"all_seasons",
"stacked_raster_values_and_garden_CT_all_seasons_no_nas_proc_20221117.RDS"))
ct_spatial<-st_as_sf(ct_locations,coords = c("Long","Lat"),remove=F,crs=32633) %>%
st_transform(crs = 3035)
#### extract covariates ----
cov<-terra::extract(focal_mean_stack,ct_spatial)%>%
data.frame()
#### bind
ct_cov<-cbind(ct_locations,cov)
saveRDS(ct_cov,here("output",
"data-proc",
"all_seasons",
"ct_focal_covariates_100.RDS"))cor<-cor(cov, use = "complete.obs")%>%
data.frame()%>%
as.matrix()
melted_cor<-reshape2::melt(cor)
ggplot(data = melted_cor, aes(x=Var2, y=forcats::fct_rev(Var1), fill=value)) +
geom_tile() +
geom_text(aes(
label = format(round(value, 2), nsmall = 2),
color = abs(value) < .75
)) +
coord_fixed(expand = F) +
scale_color_manual(values = c("white", "black"),
guide = "none") +
scale_fill_distiller(
palette = "RdBu", na.value = "white",
direction = 1, limits = c(-1, 1)
) +
labs(x = NULL, y = NULL) + scale_x_discrete(position = "top")+
theme(panel.border = element_rect(color = NA, fill = NA),
axis.text.x = element_text(angle = 45, hjust=0,size = 15),
axis.text.y = element_text(size = 15),
legend.key.size = unit(1.2,"cm"),
legend.text = element_text(size = 15),
legend.title = element_text(size = 20))
cor<-as.data.frame(layerStats(raster_stack,stat="pearson",na.rm = T))
colnames(cor)<-rownames(cor)
cor<-as.matrix(cor[,1:10])
cor[cor>=1]=1;cor[upper.tri(cor)]<-NA
melted_cor<-reshape2::melt(cor)
ggplot(data = melted_cor, aes(x=Var2, y=Var1, fill=value)) +
geom_tile() +
geom_text(aes(
label = format(round(value, 2), nsmall = 2),
color = abs(value) < .75
)) +
coord_fixed(expand = FALSE) +
scale_color_manual(values = c("white", "black"),
guide = "none") +
scale_fill_distiller(
palette = "RdBu", na.value = "white",
direction = 1, limits = c(-1, 1)
) +
labs(x = NULL, y = NULL) + scale_x_discrete(position = "top")+
theme(panel.border = element_rect(color = NA, fill = NA),
legend.position = c(.95, .4),
axis.text.x = element_text(angle = 45, hjust=0,size = 15),
axis.text.y = element_text(size = 15),
legend.key.size = unit(1.2,"cm"),
legend.text = element_text(size = 15),
legend.title = element_text(size = 20))
#ggsave(here("plots","raster_correlation.png"),width = 12, height = 9)Session Info
## DO NOT REMOVE!
## We store the settings of your computer and the current versions of the
## packages used to allow for reproducibility
Sys.time()[1] "2022-11-20 17:42:19 CET"#git2r::repository() ## uncomment if you are using GitHub
sessionInfo()R version 4.2.1 (2022-06-23 ucrt)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 17763)
Matrix products: default
locale:
[1] LC_COLLATE=German_Germany.1252 LC_CTYPE=German_Germany.1252
[3] LC_MONETARY=German_Germany.1252 LC_NUMERIC=C
[5] LC_TIME=C
attached base packages:
[1] stats graphics grDevices utils datasets methods
[7] base
other attached packages:
[1] sf_1.0-8 here_1.0.1 raster_3.6-3 sp_1.5-0
[5] forcats_0.5.2 stringr_1.4.1 dplyr_1.0.10 purrr_0.3.4
[9] readr_2.1.3 tidyr_1.2.1 tibble_3.1.8 ggplot2_3.3.6
[13] tidyverse_1.3.2
loaded via a namespace (and not attached):
[1] fs_1.5.2 lubridate_1.8.0 RColorBrewer_1.1-3
[4] httr_1.4.4 rprojroot_2.0.3 tools_4.2.1
[7] backports_1.4.1 bslib_0.4.0 rgdal_1.5-32
[10] utf8_1.2.2 R6_2.5.1 KernSmooth_2.23-20
[13] DBI_1.1.3 colorspace_2.0-3 withr_2.5.0
[16] tidyselect_1.1.2 downlit_0.4.2 compiler_4.2.1
[19] textshaping_0.3.6 cli_3.4.1 rvest_1.0.3
[22] xml2_1.3.3 labeling_0.4.2 sass_0.4.2
[25] scales_1.2.1 classInt_0.4-8 proxy_0.4-27
[28] systemfonts_1.0.4 digest_0.6.29 rmarkdown_2.16
[31] pkgconfig_2.0.3 htmltools_0.5.3 highr_0.9
[34] dbplyr_2.2.1 fastmap_1.1.0 rlang_1.0.6
[37] readxl_1.4.1 rstudioapi_0.14 farver_2.1.1
[40] jquerylib_0.1.4 generics_0.1.3 jsonlite_1.8.2
[43] distill_1.5 googlesheets4_1.0.1 magrittr_2.0.3
[46] Rcpp_1.0.9 munsell_0.5.0 fansi_1.0.3
[49] lifecycle_1.0.3 terra_1.6-17 stringi_1.7.8
[52] yaml_2.3.5 plyr_1.8.7 grid_4.2.1
[55] crayon_1.5.2 lattice_0.20-45 haven_2.5.1
[58] hms_1.1.2 knitr_1.40 pillar_1.8.1
[61] reshape2_1.4.4 codetools_0.2-18 reprex_2.0.2
[64] glue_1.6.2 evaluate_0.16 modelr_0.1.9
[67] vctrs_0.4.2 tzdb_0.3.0 cellranger_1.1.0
[70] gtable_0.3.1 assertthat_0.2.1 cachem_1.0.6
[73] xfun_0.33 broom_1.0.1 e1071_1.7-11
[76] ragg_1.2.3 class_7.3-20 googledrive_2.0.0
[79] gargle_1.2.1 memoise_2.0.1 units_0.8-0
[82] ellipsis_0.3.2